server/ext/board.ext

#! perl

sub do_help {
   my ($board, $who, $npc) = @_;
   $who->reply ($npc,
      "Help for $board\n\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) {
      my $msg = "$board content:\n\n";
      $msg .= "<$_> $cont->[$_][0]: $cont->[$_][1]\r"
         for 0 .. $#$cont;
      $who->reply ($npc, $msg);
   } 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::object::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 = Compress::LZF::sthaw cf::db_get board => "data";

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_put board => data => Compress::LZF::sfreeze_cr $BOARDDB;
   $entry
}

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

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

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

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

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