maps/perl/board.ext

#! perl
#CONVERSION: BROKEN, MISSING ON_APPLY

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

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

sub do_list {
   my ($board, $who, $npc) = @_;
   my $cont = CFBoard::get ($board);
   if (@{$cont || []}) {
      $who->message ("$board content:", cf::NDI_BROWN | cf::NDI_UNIQUE);
      my $idx = 0;
      for (@$cont) {
         $who->message ("<$idx> $_->[0]: $_->[1]", cf::NDI_BROWN | cf::NDI_UNIQUE);
         $idx++;
      }
   } else {
      $who->message ("$board is empty.", cf::NDI_BROWN | cf::NDI_UNIQUE);
   }
   1
}

sub do_remove {
   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]).");
   } else {
      $who->reply ($npc, "Access denied.");
   }

   1
}

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

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

   1
};

sub on_apply {
   my ($ev, $npc, $who) = @_;
   $who->reply ($npc, "Hello, i'm a talking board, 'say help' to get help");
   do_list ($npc->name, $who, $npc);
   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;
Revision:	1.5
Committed:	Fri Aug 25 17:08:19 2006 UTC (17 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.4:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	elmex	1.1	#! perl
2	root	1.5	#CONVERSION: BROKEN, MISSING ON_APPLY
3	elmex	1.1
4	elmex	1.2	sub do_help {
5	elmex	1.1	my ($board, $who, $npc) = @_;
6			$who->reply ($npc,
7			"Help for $board\n"
8			."List of commands:\n\n"
9			."- list\n"
10			."- write <message>\n"
11			."- remove <id>\n"
12			);
13	elmex	1.2	}
14	elmex	1.1
15	elmex	1.2	sub do_write {
16	elmex	1.1	my ($board, $msg, $who, $npc) = @_;
17			if ($msg =~ /\S/) {
18			CFBoard::write ($board, $who->name, $msg);
19	elmex	1.2	$who->reply ($npc, "Added entry.");
20	elmex	1.1	} else {
21			$who->reply ($npc, "Usage: write <message>\n");
22			}
23			1
24	elmex	1.2	}
25	elmex	1.1
26	elmex	1.2	sub do_list {
27	elmex	1.1	my ($board, $who, $npc) = @_;
28			my $cont = CFBoard::get ($board);
29	elmex	1.2	if (@{$cont \|\| []}) {
30			$who->message ("$board content:", cf::NDI_BROWN \| cf::NDI_UNIQUE);
31	elmex	1.1	my $idx = 0;
32			for (@$cont) {
33	elmex	1.2	$who->message ("<$idx> $_->[0]: $_->[1]", cf::NDI_BROWN \| cf::NDI_UNIQUE);
34	elmex	1.1	$idx++;
35			}
36			} else {
37	elmex	1.3	$who->message ("$board is empty.", cf::NDI_BROWN \| cf::NDI_UNIQUE);
38	elmex	1.1	}
39			1
40	elmex	1.2	}
41	elmex	1.1
42	elmex	1.2	sub do_remove {
43	elmex	1.1	my ($board, $idx, $who, $npc) = @_;
44
45			my $entry = CFBoard::get_idx ($board, $idx);
46			unless (defined $entry) {
47			$who->reply ($npc, "No such entry.");
48			return 1;
49			}
50
51			if ($entry->[0] eq $who->name or $who->flag (cf::FLAG_WIZ)) {
52			my $e = CFBoard::remove_idx ($board, $idx);
53	elmex	1.2	$who->reply ($npc, "Removed entry $idx ($e->[0]: $e->[1]).");
54	elmex	1.1	} else {
55			$who->reply ($npc, "Access denied.");
56			}
57	elmex	1.2
58			1
59			}
60
61			# this is the main command interface for the IPO NPC
62			cf::register_script_function "board::command" => sub {
63			my ($who, $msg, $npc) = @_;
64			my $board = $npc->name;
65
66			if ($msg =~ /^list$/i) {
67			do_list ($board, $who, $npc);
68			} elsif ($msg =~ /^write (.+)$/i) {
69			do_write ($board, $1, $who, $npc);
70			} elsif ($msg =~ /^remove (\d+)$/i) {
71			do_remove ($board, $1, $who, $npc);
72			} else {
73			do_help ($board, $who, $npc);
74			}
75
76	elmex	1.1	1
77			};
78
79	elmex	1.2	sub on_apply {
80			my ($ev, $npc, $who) = @_;
81			$who->reply ($npc, "Hello, i'm a talking board, 'say help' to get help");
82			do_list ($npc->name, $who, $npc);
83			1;
84			}
85	elmex	1.1
86			package CFBoard;
87			use POSIX qw/strftime/;
88			use CFDB;
89
90			my $BOARDDB = CFDB->new (db_file => cf::localdir . "/crossfireboard.perl");
91
92			sub get {
93			my ($board) = @_;
94			$BOARDDB->get ($board);
95			}
96
97			sub get_idx {
98			my ($board, $idx) = @_;
99			$board = $BOARDDB->get ($board);
100			return $board->[$idx];
101			}
102
103			sub remove_idx {
104			my ($boardname, $idx) = @_;
105			my $board = $BOARDDB->get ($boardname);
106			my $e = splice @$board, $idx, 1;
107			$BOARDDB->set ($boardname, $board);
108			$e
109			}
110
111			sub clear {
112			my ($board) = @_;
113			$BOARDDB->clear ($board);
114			}
115
116			sub write {
117			my ($board, $from, $message) = @_;
118			my $boardentrys = $BOARDDB->get ($board);
119			push @$boardentrys, [$from, $message];
120			$BOARDDB->set ($board, $boardentrys);
121			}
122
123			1;