#! perl

use Data::Dumper;
use Carp;
cf::register_script_function "board::help" => sub {
#   eval { Carp::confess; }; print "[[$@$!]]\n"; require Data::Dumper;
   my ($board, $who, $npc) = @_;
   $who->reply ($npc,
      "Help for $board\n"
     ."List of commands:\n\n"
     ."- list\n"
     ."- write <message>\n"
     ."- remove <id>\n"
   );
};

cf::register_script_function "board::write" => sub {
   my ($board, $msg, $who, $npc) = @_;
   if ($msg =~ /\S/) {
      CFBoard::write ($board, $who->name, $msg);
      $who->reply ($npc, "Added to $board");
   } else {
      $who->reply ($npc, "Usage: write <message>\n");
   }
   1
};

cf::register_script_function "board::list" => sub {
   my ($board, $who, $npc) = @_;
   my $cont = CFBoard::get ($board);
   if (@$cont) {
      $who->reply ($npc, "Content of $board:");
      my $idx = 0;
      for (@$cont) {
         $who->reply ($npc, "<$idx> $_->[0]: $_->[1]");
         $idx++;
      }
   } else {
      $who->reply ($npc, "$board is empty.");
   }
   1
};

cf::register_script_function "board::remove" => sub {
   my ($board, $idx, $who, $npc) = @_;

   my $entry = CFBoard::get_idx ($board, $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 = CFBoard::remove_idx ($board, $idx);
      $who->reply ($npc, "Removed entry $idx ($e->[0]: $e->[1]) from $board.");
   } else {
      $who->reply ($npc, "Access denied.");
   }
   1
};


package CFBoard;
use POSIX qw/strftime/;
use CFDB;

my $BOARDDB = CFDB->new (db_file => cf::localdir . "/crossfireboard.perl");

sub get {
   my ($board) = @_;
   $BOARDDB->get ($board);
}

sub get_idx {
   my ($board, $idx) = @_;
   $board = $BOARDDB->get ($board);
   return $board->[$idx];
}

sub remove_idx {
   my ($boardname, $idx) = @_;
   my $board = $BOARDDB->get ($boardname);
   my $e = splice @$board, $idx, 1;
   $BOARDDB->set ($boardname, $board);
   $e
}

sub clear {
   my ($board) = @_;
   $BOARDDB->clear ($board);
}

sub write {
   my ($board, $from, $message) = @_;
   my $boardentrys = $BOARDDB->get ($board);
   push @$boardentrys, [$from, $message];
   $BOARDDB->set ($board, $boardentrys);
}

1;