maps/perl/board.ext

#! perl

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::put_entry ($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->reply ($npc, "$board content:");
      my $idx = 0;
      for (@$cont) {
         $who->reply ($npc, "<$idx> $_->[0]: $_->[1]");
         $idx++;
      }
   } else {
      $who->reply ($npc, "$board is empty.");
   }
   1
}

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

   my $entry = CFBoard::get_entry ($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_entry ($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
};

cf::register_attachment board =>
   on_apply => sub {
      my ($npc, $who) = @_;
      $who->reply ($npc, "Hello, i'm a talking board, 'say help' to get help");
      do_list ($npc->name, $who, $npc);
      cf::override;
   },
;

package CFBoard;

use POSIX qw/strftime/;
use CFDB;

my $BOARDDB = cf::db_get "board";

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

   $BOARDDB->{"msg_$board"} ||= []
}

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

   $BOARDDB->{"msg_$board"}[$idx]
}

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

   my $entry = splice @{ $BOARDDB->{"msg_$board"} ||= [] }, $idx, 1;
   cf::db_dirty;
   $entry
}

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

   delete $BOARDDB->{"msg_$board"};
   cf::db_dirty;
}

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

   my $entries = $BOARDDB->{"msg_$board"} ||= [];
   push @$entries, [$from, $message];
   cf::db_dirty;
}

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