ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cf.schmorp.de/maps/perl/board.ext
Revision: 1.9
Committed: Fri Dec 15 19:11:46 2006 UTC (17 years, 7 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.8: +0 -0 lines
State: FILE REMOVED
Log Message:
move .ext to server

File Contents

# Content
1 #! perl
2
3 sub do_help {
4 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 }
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 if (@{$cont || []}) {
29 $who->reply ($npc, "$board content:");
30 my $idx = 0;
31 for (@$cont) {
32 $who->reply ($npc, "<$idx> $_->[0]: $_->[1]");
33 $idx++;
34 }
35 } else {
36 $who->reply ($npc, "$board is empty.");
37 }
38 1
39 }
40
41 sub do_remove {
42 my ($board, $idx, $who, $npc) = @_;
43
44 my $entry = CFBoard::get_entry ($board, $idx);
45 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 my $e = CFBoard::remove_entry ($board, $idx);
52 $who->reply ($npc, "Removed entry $idx ($e->[0]: $e->[1]).");
53 } else {
54 $who->reply ($npc, "Access denied.");
55 }
56
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 1
76 };
77
78 cf::register_attachment board =>
79 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
87 package CFBoard;
88
89 use POSIX qw/strftime/;
90 use CFDB;
91
92 my $BOARDDB = cf::db_get "board";
93
94 sub get {
95 my ($board) = @_;
96
97 $BOARDDB->{"msg_$board"} ||= []
98 }
99
100 sub get_entry {
101 my ($board, $idx) = @_;
102
103 $BOARDDB->{"msg_$board"}[$idx]
104 }
105
106 sub remove_entry {
107 my ($board, $idx) = @_;
108
109 my $entry = splice @{ $BOARDDB->{"msg_$board"} ||= [] }, $idx, 1;
110 cf::db_dirty;
111 $entry
112 }
113
114 sub clear {
115 my ($board) = @_;
116
117 delete $BOARDDB->{"msg_$board"};
118 cf::db_dirty;
119 }
120
121 sub put_entry {
122 my ($board, $from, $message) = @_;
123
124 my $entries = $BOARDDB->{"msg_$board"} ||= [];
125 push @$entries, [$from, $message];
126 cf::db_dirty;
127 }
128
129 1;