Navigation

← Previous Changeset
Next Changeset →

Changeset 171

Timestamp:

07/06/04 02:22:14 (4 years ago)

Author:

svn

Message:

Added context support. This breaks all previous ACTION and HELP subroutines, in
that the first argument is now a CLI::Context object.

Files:

manage/trunk/CLI/Context.pm (added)
manage/trunk/CLI.pm (modified) (15 diffs)
manage/trunk/manage (modified) (7 diffs)
manage/trunk/plugins/nodelist2.pm (modified) (2 diffs)

Legend:

: Unmodified
: Added
: Removed
: Modified
: Copied
: Moved

manage/trunk/CLI.pm

r170	r171
11	11	use Term::ReadKey;
12	12	use POSIX qw(ctermid floor);
	13	use CLI::Context;
13	14
14	15	$VERSION = 0.1;
…	…
106	107	#
107	108	# parse_node(\@tokens [, $node, \@args, $trackall])
	109	# parse_node($ctx [, $trackall])
108	110	sub parse_node {
109	111	my $self = shift;
110		my @tokens = @{$_[0]};
111		my %cmd = (@_ > 1 ? %{$_[1]} : %{$self->{grammar}});
112		my @args = (@_ > 2 ? @{$_[2]} : ());
113		my $trackallparent = (@_ > 3 ? $_[3] : 0);
114		my $token = shift(@tokens);
	112	my $ctx = shift;
	113	my $cmd = $ctx->current_grammar();
	114	my $trackallparent = @_ ? shift() : 0;
	115	my $token = $ctx->next_token();
115	116	my ($width, $height) = GetTerminalSize(*STDIN);
116	117
…	…
125	126
126	127	# Trailing tokens after help
127		return ('ERROR', 'Trailing tokens after ?') if ~~@tokens~~;
	128	return ('ERROR', 'Trailing tokens after ?') if $ctx->more_tokens();
128	129
129	130	# Construct help string
130		$help .= $format->paragraphs(split(/^\s*$/m, $cmd~~{HELPHEADER})) . "\n" if $cmd~~{HELPHEADER};
	131	$help .= $format->paragraphs(split(/^\s*$/m, $cmd->{HELPHEADER})) . "\n" if $cmd->{HELPHEADER};
131	132
132	133	my $process_help = sub {
…	…
139	140	$commands->{$help->[0]} = $help->[1];
140	141	} elsif ($type eq 'CODE') {
141		%$commands = (%$commands, $help->(~~@args~~));
	142	%$commands = (%$commands, $help->($ctx));
142	143	} elsif (!$type) {
143	144	$commands->{$command} = $help;
…	…
145	146	};
146	147
147		for my $key (keys %cmd) {
	148	for my $key (keys %$cmd) {
148	149	my $text = $key;
149	150
…	…
151	152	$text =~ s/^(\d+\))?(\$(\*)?)?//;
152	153
153		if (ref($cmd~~{$key}) eq 'HASH' and $cmd~~{$key}->{HELP}) {
154		$process_help->($cmd{$key}->{HELP}, \%commands, $text);
	154	if (ref($cmd->{$key}) eq 'HASH' and $cmd->{$key}->{HELP}) {
	155	$process_help->($cmd->{$key}->{HELP}, \%commands, $text);
155	156	} else {
156	157	$commands{$text} = '';
…	…
161	162	# key. If it exists, use this as the help line for <eol>, otherwise try
162	163	# HELP, then generate a warning.
163		if ($cmd{ACTION}) {
164		if (ref($cmd~~{ACTION}) eq 'HASH' and $cmd~~{ACTION}->{HELP}) {
165		$process_help->($cmd{ACTION}->{HELP}, \%commands, '<eol>');
166		} elsif ($cmd{ACTIONHELP}) {
167		$commands{'<eol>'} = $cmd{ACTIONHELP};
168		} elsif ($cmd{HELP}) {
169		$process_help->($cmd{HELP}, \%commands, '<eol>');
	164	if ($cmd->{ACTION}) {
	165	if (ref($cmd->{ACTION}) eq 'HASH' and $cmd->{ACTION}->{HELP}) {
	166	$process_help->($cmd->{ACTION}->{HELP}, \%commands, '<eol>');
	167	} elsif ($cmd->{ACTIONHELP}) {
	168	$commands{'<eol>'} = $cmd->{ACTIONHELP};
	169	} elsif ($cmd->{HELP}) {
	170	$process_help->($cmd->{HELP}, \%commands, '<eol>');
170	171	} else {
171	172	$commands{'<eol>'} = "\e[31m\e[1m(need ACTIONHELP, ACTION->HELP or HELP entry)\e[0m";
…	…
187	188	}
188	189
189		$help .= "\n" if $cmd~~{HELPFOOTER} or $cmd~~{HELPHEADER};
190		$help .= $cmd~~{HELPFOOTER} . "\n" if $cmd~~{HELPFOOTER};
	190	$help .= "\n" if $cmd->{HELPFOOTER} or $cmd->{HELPHEADER};
	191	$help .= $cmd->{HELPFOOTER} . "\n" if $cmd->{HELPFOOTER};
191	192	return ('ERROR', 'No help available.') unless defined($help) and $help ne '';
192	193	return ('HELP', $help);
…	…
194	195
195	196	# Parse command itself
196		if (defined($token) or $cmd~~{ACTION} or $cmd~~{ERROR}) {
	197	if (defined($token) or $cmd->{ACTION} or $cmd->{ERROR}) {
197	198	for my $rx (sort {
198	199	my ($lhs, $rhs) = ($a =~ /^\d+\)/, $b =~ /^\d+\)/);
…	…
226	227	}
227	228	}
228		} keys %cmd) {
	229	} keys %$cmd) {
229	230	my $key = $rx;
230	231	my $trackvar = 0;
…	…
252	253
253	254	if (defined($token)) {
254		my @candidates = grep(/^(\d+\))?(\$(\*)?)?\Q$token\E/, keys(%cmd));
	255	my @candidates = grep(/^(\d+\))?(\$(\*)?)?\Q$token\E/, keys(%$cmd));
255	256
256	257	$unique = 1 if @candidates == 1 and $candidates[0] eq $key;
…	…
258	259
259	260	if ($unique or (!defined($token) and $rx eq 'ACTION') or (defined($token) and $token =~ /^(?:$rx)$/is)) {
260		my $type = ref($cmd{$key});
261
262		~~push(@args,~~ $token) if $trackvar;
	261	my $type = ref($cmd->{$key});
	262
	263	$ctx->next_arg($token) if $trackvar;
263	264
264	265	# Recurse if we are tracking
265		return $self->parse_node(~~\@tokens, \%cmd, \@args~~, $trackall)
266		if ~~@tokens~~ and $trackall;
	266	return $self->parse_node($ctx->next_grammar($cmd), $trackall)
	267	if $ctx->more_tokens() and $trackall;
267	268
268	269	if ($type eq 'HASH') {
269		~~push(@tokens,~~ $token) if $rx eq 'ACTION';
270		return $self->parse_node(~~\@tokens, $cmd{$key}, \@args~~);
	270	$ctx->inject_token($token) if $rx eq 'ACTION';
	271	return $self->parse_node($ctx->next_grammar($cmd->{$key}));
271	272	} elsif ($type eq 'CODE') {
272	273	# Tokens are still remaining
273		if (~~@tokens~~) {
	274	if ($ctx->more_tokens()) {
274	275	return ('HELP', "\e[32m\e[1mOK Command is complete.\e[0m\n")
275		if ~~"@tokens"~~ eq '?';
276		return ('ERROR', "Trailing tokens: '~~@tokens~~' (possibly missing help?).")
	276	if $ctx->peek_token() eq '?';
	277	return ('ERROR', "Trailing tokens: '" . join(" ", $ctx->more_tokens()) . "' (possibly missing help?).")
277	278	}
278		return ('ACTION', $cmd~~{$key}, \@args~~);
	279	return ('ACTION', $cmd->{$key}, $ctx);
279	280	} else {
280	281	return ('ERROR', 'Invalid terminal node, should be CODE or HASH.');
…	…
284	285	}
285	286	return ('ERROR', 'More input expected.') unless defined($token);
286		if ($cmd{ERROR}) {
287		my $error = $cmd{ERROR};
	287	if ($cmd->{ERROR}) {
	288	my $error = $cmd->{ERROR};
288	289
289	290	$error =~ s/\${ARG}/$token/g;
…	…
291	292	} else {
292	293	if (defined($token)) {
293		my @rawcandidates = grep(/^(\d+\))?(\$(\*)?)?\Q$token\E/, keys(%cmd));
	294	my @rawcandidates = grep(/^(\d+\))?(\$(\*)?)?\Q$token\E/, keys(%$cmd));
294	295
295	296	if (@rawcandidates > 1) {
…	…
330	331	}
331	332	}
332		return $self->parse_node(\@tokens);
	333	return $self->parse_node(new CLI::Context(
	334	tokens => \@tokens,
	335	grammar => $self->{grammar},
	336	));
333	337	}
334	338

manage/trunk/manage

r170	r171
207	207
208	208	sub exec_line {
209		my ($type, $action, $~~args~~) = $CLI->parse("@_");
	209	my ($type, $action, $ctx) = $CLI->parse("@_");
210	210
211	211	if ($type eq 'HELP') {
212	212	print($action);
213	213	} elsif ($type eq 'ACTION') {
214		$action->($~~CLI, @{$args~~});
	214	$action->($ctx, @{$ctx->args()});
215	215	} elsif ($type eq 'ERROR') {
216	216	error($action);
…	…
248	248	'$.+' => {
249	249	ACTION => sub {
	250	my $ctx = shift;
250	251	my ($key, $value) = @_;
251	252
…	…
266	267	},
267	268	HELP => sub {
	269	my $ctx = shift;
268	270	my %help;
269	271
…	…
275	277	ACTION => {
276	278	ACTION => sub {
	279	my $ctx = shift;
277	280	my $key = shift;
278	281
…	…
290	293	HELP => 'Display full list of settings.',
291	294	ACTION => sub {
	295	my $ctx = shift;
292	296	my @rows = ();
293	297
…	…
302	306	clear => {
303	307	ACTION => sub {
	308	my $ctx = shift;
	309
	310	print(join(" ", @{$ctx->{token_history}}) . "\n");
304	311	Term::ReadLine::Gnu->clear_history();
305	312	info("History cleared");
…	…
308	315	},
309	316	ACTION => sub {
	317	my $ctx = shift;
310	318	print(join("\n", Term::ReadLine::Gnu->GetHistory) . "\n");
311	319	},

manage/trunk/plugins/nodelist2.pm

r170	r171
2	2
3	3	{
4		~~HELPHEADER => "Fooo",~~
5	4	test => {
6	5	'1)lalala' => sub { print "FOO\n"; },
…	…
14	13	ACTION => {
15	14	ACTION => sub {
16		print("STUFF: @_\n");
	15	my $c = shift;
	16
	17	print("@_\n");
17	18	},
18	19	HELP => "Do it.",