diff options
author | Peter Powell <petpow@saberuk.com> | 2017-03-24 23:11:40 +0000 |
---|---|---|
committer | Peter Powell <petpow@saberuk.com> | 2017-03-25 00:54:25 +0000 |
commit | b6a69e98ee6c08b874def397ee6a490d4ab8863c (patch) | |
tree | 7b385bee553427b73c8945c6e57e2657ba6a44d3 | |
parent | d43056bf6abc2e63ecf798085bf78b2aabd61618 (diff) |
Add a nice API for command line interfaces to make::console.
-rw-r--r-- | make/console.pm | 55 |
1 files changed, 50 insertions, 5 deletions
diff --git a/make/console.pm b/make/console.pm index 84fbaae4a..0d3c1b38d 100644 --- a/make/console.pm +++ b/make/console.pm @@ -1,7 +1,7 @@ # # InspIRCd -- Internet Relay Chat Daemon # -# Copyright (C) 2014 Peter Powell <petpow@saberuk.com> +# Copyright (C) 2014-2017 Peter Powell <petpow@saberuk.com> # # This file is part of InspIRCd. InspIRCd is free software: you can # redistribute it and/or modify it under the terms of the GNU General Public @@ -27,11 +27,14 @@ use feature ':5.10'; use strict; use warnings FATAL => qw(all); +use Class::Struct qw(struct); +use Exporter qw(import); use File::Path qw(mkpath); use File::Spec::Functions qw(rel2abs); -use Exporter qw(import); -our @EXPORT = qw(print_format +our @EXPORT = qw(command + execute_command + print_format print_error print_warning prompt_bool @@ -39,8 +42,9 @@ our @EXPORT = qw(print_format prompt_string); my %FORMAT_CODES = ( - DEFAULT => "\e[0m", - BOLD => "\e[1m", + DEFAULT => "\e[0m", + BOLD => "\e[1m", + UNDERLINE => "\e[4m", RED => "\e[1;31m", GREEN => "\e[1;32m", @@ -48,6 +52,13 @@ my %FORMAT_CODES = ( BLUE => "\e[1;34m" ); +my %commands; + +struct 'command' => { + 'callback' => '$', + 'description' => '$', +}; + sub __console_format($$) { my ($name, $data) = @_; return $data unless -t STDOUT; @@ -111,4 +122,38 @@ sub prompt_string($$$) { return $answer ? $answer : $default; } +sub command($$$) { + my ($name, $description, $callback) = @_; + $commands{$name} = command->new; + $commands{$name}->callback($callback); + $commands{$name}->description($description); +} + +sub command_alias($$) { + my ($source, $target) = @_; + command $source, undef, sub(@) { + execute_command $target, @_; + }; +} + +sub execute_command(@) { + my $command = defined $_[0] ? lc shift : 'help'; + if ($command eq 'help') { + print_format "<|GREEN Usage:|> $0 <<|UNDERLINE COMMAND|>> [<|UNDERLINE OPTIONS...|>]\n\n"; + print_format "<|GREEN Commands:|>\n"; + for my $key (sort keys %commands) { + next unless defined $commands{$key}->description; + my $name = sprintf "%-15s", $key; + my $description = $commands{$key}->description; + print_format " <|BOLD $name|> # $description\n"; + } + exit 0; + } elsif (!$commands{$command}) { + print_error "no command called <|BOLD $command|> exists!", + "See <|BOLD $0 help|> for a list of commands."; + } else { + return $commands{$command}->callback->(@_); + } +} + 1; |