server/ext/help.ext

#! perl # mandatory depends=doclet

our $TOPIC;
our %DOCLET;

our $HELP_CHANNEL = {
   id      => "help",
   title   => "Help",
   reply   => "help ",
   tooltip => "Online Help",
};

# these commands should be preferred by the client completer
# we put them first in their own face.
our @PREFERRED = qw(chat say shout tell);

# considerable duplication between load_doclets and load_topics
sub load_doclets {
   %DOCLET = ();

   my %command_list;
   my %preferred = map { $_ => undef } @PREFERRED;

   for (
      [standard => "command_help"],
      [emote    => "emote_help"],
      [dm       => "dmcommand_help"],
   ) {
      my ($type, $path) = @$_;

      my $paragraphs = cf::pod::load_pod "$PODDIR/$path.pod"
         or die "unable to load $path";

      my $level = 1e9;
      my $rpar;

      for my $par (@$paragraphs) {
         if ($par->{type} eq "head2") {
            # this code taken almost verbatim from DC/Protocol.pm

            if ($par->{markup} =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x) {
               my $cmd = $1;
               my @args = split /\|/, $2;
               @args = (".*") unless @args;

               $_ = $_ eq ".*" ? "" : " $_"
                  for @args;

               my @variants = map "$cmd$_", sort { (length $a) <=> (length $b) } @args;

               $rpar = \($DOCLET{$cmd} = &cf::pod::as_cfpod ([$par]));

               push @{ $command_list{$type} }, @variants;
               $level = $par->{level};
            } else {
               cf::error "$par->{markup}: unparsable command heading";
            }
         } elsif ($par->{level} > $level) {
            $$rpar .= &cf::pod::as_cfpod ([$par]);
         }

         cf::cede_to_tick;
      }
   }

   cf::cede_to_tick;

   @$_ = grep !exists $preferred{$_}, @$_
      for values %command_list;

   $command_list{preferred} = \@PREFERRED;

   while (my ($k, $v) = each %command_list) {
      cf::cede_to_tick;
      cf::client::set_command_face $k, $v;
   }
}

our $DOCLET_HANDLER = ext::doclet::register command => sub {
   my ($pl, $category, $command) = @_;

   if ($command =~ /^(cast|invoke)\s+(.*)$/) { # not used currently
      my ($cmd, $arg) = ($1, $2);
      (ext::doclet::doclet $pl, command => $cmd)
      . (ext::doclet::doclet $pl, spell => $arg)
   } elsif ($command =~ /^(ready_skill|use_skill)\s+(.*)$/) {
      my ($cmd, $arg) = ($1, $2);
      (ext::doclet::doclet $pl, command => $cmd)
      . (ext::doclet::doclet $pl, skill => $arg)
   } else {
      my $guard = cf::lock_acquire "ext::help::loading";

      $DOCLET{$command}
         || "B<No documentation available for '$category/$command'>"
   }
};

sub load_topics($$) {
   my ($type, $path) = @_;

   my $paragraphs = cf::pod::load_pod "$PODDIR/$path.pod"
      or die "unable to load $path";

   my @topics;
   my $level = 1e9;

   for my $par (@$paragraphs) {
      cf::cede_to_tick;
      if ($par->{type} eq "head2") {
         if ($par->{markup} =~ /^(\S+)/) {
            push @topics, $1 => [$type => $par];
            $level = $par->{level};
         }
      } elsif ($par->{level} > $level) {
         push @{ $topics[-1] }, $par;
      }
   }

   @topics
}

sub reload() {
   my $guard1 = cf::lock_acquire "ext::help::loading";
   my $guard2 = cf::lock_acquire "ext::resource";

   local $Coro::current->{desc} = "help loader";

   $TOPIC = {
      (load_topics "DM Commands" => "dmcommand_help"),
      (load_topics "Emotes" => "emote_help"),
      (load_topics "Commands" => "command_help"),
      (load_topics "Generic Help Topics" => "generic_help"),
   };
   
   load_doclets;

   ()
}

cf::post_init {
   cf::async_ext { reload };
   Coro::cede; # make sure reload acquires the lock(s)
};

cf::register_command help => sub {
   my ($pl, $topic) = @_;

   if (cf::lock_active "ext::help::loading") {
      $pl->send_msg ($HELP_CHANNEL => "help files are being loaded currently, try again in a few seconds.", cf::NDI_REPLY | cf::NDI_CLEAR);
      return;
   }

   $topic = $1 if $topic =~ /(\S+)/;

   if (!length $topic) {
      # sort..

      my %topics;
      while (my ($k, $v) = each %$TOPIC) {
         push @{$topics{$v->[0]}}, $k;
      }

      my $res;
      while (my ($k, $v) = each %topics) {
         $res .= "T<$k:>\n\n" . (join "    ", sort @$v) . "\n\n";
      }

      $pl->send_msg ($HELP_CHANNEL => $res, cf::NDI_REPLY | cf::NDI_CLEAR);

   } elsif (my $item = $TOPIC->{$topic}) {
      my ($type, @pars) = @$item;
      $pl->send_msg ($HELP_CHANNEL => (cf::pod::as_cfpod \@pars), cf::NDI_REPLY | cf::NDI_CLEAR);

   } else {
      $pl->send_msg ($HELP_CHANNEL => "'$topic' no such help topic, try just 'help' to get a list of topics.", cf::NDI_REPLY);
   }
};

Revision:	1.23
Committed:	Mon Nov 26 13:12:16 2012 UTC (11 years, 5 months ago) by root
Branch:	MAIN
CVS Tags:	rel-3_1, HEAD
Changes since 1.22:	+12 -1 lines
Log Message:	order commands by preference
#	User	Rev	Content
1	root	1.18	#! perl # mandatory depends=doclet
2	pippijn	1.1
3	root	1.2	our $TOPIC;
4	root	1.18	our %DOCLET;
5	root	1.2
6	root	1.12	our $HELP_CHANNEL = {
7			id => "help",
8			title => "Help",
9			reply => "help ",
10			tooltip => "Online Help",
11			};
12
13	root	1.23	# these commands should be preferred by the client completer
14			# we put them first in their own face.
15			our @PREFERRED = qw(chat say shout tell);
16
17	root	1.18	# considerable duplication between load_doclets and load_topics
18			sub load_doclets {
19			%DOCLET = ();
20
21	root	1.21	my %command_list;
22	root	1.23	my %preferred = map { $_ => undef } @PREFERRED;
23	root	1.18
24			for (
25	root	1.21	[standard => "command_help"],
26			[emote => "emote_help"],
27			[dm => "dmcommand_help"],
28	root	1.18	) {
29			my ($type, $path) = @$_;
30
31			my $paragraphs = cf::pod::load_pod "$PODDIR/$path.pod"
32			or die "unable to load $path";
33
34			my $level = 1e9;
35			my $rpar;
36
37			for my $par (@$paragraphs) {
38			if ($par->{type} eq "head2") {
39			# this code taken almost verbatim from DC/Protocol.pm
40
41			if ($par->{markup} =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x) {
42			my $cmd = $1;
43			my @args = split /\\|/, $2;
44			@args = (".*") unless @args;
45
46			$_ = $_ eq ".*" ? "" : " $_"
47			for @args;
48
49			my @variants = map "$cmd$_", sort { (length $a) <=> (length $b) } @args;
50
51			$rpar = \($DOCLET{$cmd} = &cf::pod::as_cfpod ([$par]));
52
53	root	1.21	push @{ $command_list{$type} }, @variants;
54	root	1.18	$level = $par->{level};
55			} else {
56			cf::error "$par->{markup}: unparsable command heading";
57			}
58			} elsif ($par->{level} > $level) {
59			$$rpar .= &cf::pod::as_cfpod ([$par]);
60			}
61
62			cf::cede_to_tick;
63			}
64			}
65
66	root	1.20	cf::cede_to_tick;
67	root	1.18
68	root	1.23	@$_ = grep !exists $preferred{$_}, @$_
69			for values %command_list;
70
71			$command_list{preferred} = \@PREFERRED;
72
73	root	1.21	while (my ($k, $v) = each %command_list) {
74	root	1.23	cf::cede_to_tick;
75			cf::client::set_command_face $k, $v;
76	root	1.21	}
77	root	1.18	}
78
79			our $DOCLET_HANDLER = ext::doclet::register command => sub {
80			my ($pl, $category, $command) = @_;
81
82	root	1.22	if ($command =~ /^(cast\|invoke)\s+(.*)$/) { # not used currently
83			my ($cmd, $arg) = ($1, $2);
84			(ext::doclet::doclet $pl, command => $cmd)
85			. (ext::doclet::doclet $pl, spell => $arg)
86			} elsif ($command =~ /^(ready_skill\|use_skill)\s+(.*)$/) {
87			my ($cmd, $arg) = ($1, $2);
88			(ext::doclet::doclet $pl, command => $cmd)
89			. (ext::doclet::doclet $pl, skill => $arg)
90			} else {
91			my $guard = cf::lock_acquire "ext::help::loading";
92	root	1.18
93	root	1.22	$DOCLET{$command}
94			\|\| "B<No documentation available for '$category/$command'>"
95			}
96	root	1.18	};
97
98	root	1.3	sub load_topics($$) {
99			my ($type, $path) = @_;
100	root	1.2
101			my $paragraphs = cf::pod::load_pod "$PODDIR/$path.pod"
102			or die "unable to load $path";
103
104			my @topics;
105			my $level = 1e9;
106
107			for my $par (@$paragraphs) {
108	root	1.11	cf::cede_to_tick;
109	root	1.2	if ($par->{type} eq "head2") {
110			if ($par->{markup} =~ /^(\S+)/) {
111	root	1.3	push @topics, $1 => [$type => $par];
112	root	1.2	$level = $par->{level};
113			}
114			} elsif ($par->{level} > $level) {
115			push @{ $topics[-1] }, $par;
116			}
117			}
118
119			@topics
120			}
121
122			sub reload() {
123	root	1.18	my $guard1 = cf::lock_acquire "ext::help::loading";
124			my $guard2 = cf::lock_acquire "ext::resource";
125	root	1.15
126			local $Coro::current->{desc} = "help loader";
127
128	root	1.2	$TOPIC = {
129	root	1.3	(load_topics "DM Commands" => "dmcommand_help"),
130			(load_topics "Emotes" => "emote_help"),
131			(load_topics "Commands" => "command_help"),
132			(load_topics "Generic Help Topics" => "generic_help"),
133	root	1.2	};
134	root	1.18
135			load_doclets;
136	root	1.13
137			()
138	root	1.2	}
139
140	root	1.15	cf::post_init {
141	root	1.17	cf::async_ext { reload };
142	root	1.18	Coro::cede; # make sure reload acquires the lock(s)
143	root	1.2	};
144
145	root	1.3	cf::register_command help => sub {
146	root	1.2	my ($pl, $topic) = @_;
147
148			if (cf::lock_active "ext::help::loading") {
149	root	1.12	$pl->send_msg ($HELP_CHANNEL => "help files are being loaded currently, try again in a few seconds.", cf::NDI_REPLY \| cf::NDI_CLEAR);
150	root	1.2	return;
151			}
152	root	1.3
153			$topic = $1 if $topic =~ /(\S+)/;
154
155			if (!length $topic) {
156			# sort..
157
158			my %topics;
159			while (my ($k, $v) = each %$TOPIC) {
160			push @{$topics{$v->[0]}}, $k;
161			}
162
163			my $res;
164			while (my ($k, $v) = each %topics) {
165	root	1.14	$res .= "T<$k:>\n\n" . (join " ", sort @$v) . "\n\n";
166	root	1.3	}
167
168	root	1.12	$pl->send_msg ($HELP_CHANNEL => $res, cf::NDI_REPLY \| cf::NDI_CLEAR);
169	root	1.3
170	root	1.7	} elsif (my $item = $TOPIC->{$topic}) {
171			my ($type, @pars) = @$item;
172	root	1.12	$pl->send_msg ($HELP_CHANNEL => (cf::pod::as_cfpod \@pars), cf::NDI_REPLY \| cf::NDI_CLEAR);
173	root	1.3
174			} else {
175	root	1.12	$pl->send_msg ($HELP_CHANNEL => "'$topic' no such help topic, try just 'help' to get a list of topics.", cf::NDI_REPLY);
176	root	1.3	}
177	root	1.2	};
178	root	1.3