X-Git-Url: https://git.netwichtig.de/gitweb/?a=blobdiff_plain;f=make%2Fconsole.pm;h=0d3c1b38d6f962fe96dda066346cb2ecdda5a1a3;hb=bb4aa10ed82612624da45d0c9592ddf7f2f51ab5;hp=621de0274293815f8c5bcbd728310ea3d41b4d2e;hpb=b9e11915a976daaf790ebc763aff56e19fd49e0f;p=user%2Fhenk%2Fcode%2Finspircd.git diff --git a/make/console.pm b/make/console.pm index 621de0274..0d3c1b38d 100644 --- a/make/console.pm +++ b/make/console.pm @@ -1,7 +1,7 @@ # # InspIRCd -- Internet Relay Chat Daemon # -# Copyright (C) 2014 Peter Powell +# Copyright (C) 2014-2017 Peter Powell # # 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; @@ -57,22 +68,26 @@ sub __console_format($$) { sub print_format($;$) { my $message = shift; my $stream = shift // *STDOUT; - while ($message =~ /(<\|(\S+)\s(.+?)\|>)/) { + while ($message =~ /(<\|(\S+)\s(.*?)\|>)/) { my $formatted = __console_format $2, $3; $message =~ s/\Q$1\E/$formatted/; } print { $stream } $message; } -sub print_error($) { - my $message = shift; - print_format "<|RED Error:|> $message\n", *STDERR; +sub print_error { + print_format "<|RED Error:|> ", *STDERR; + for my $line (@_) { + print_format "$line\n", *STDERR; + } exit 1; } -sub print_warning($) { - my $message = shift; - print_format "<|YELLOW Warning:|> $message\n", *STDERR; +sub print_warning { + print_format "<|YELLOW Warning:|> ", *STDERR; + for my $line (@_) { + print_format "$line\n", *STDERR; + } } sub prompt_bool($$$) { @@ -107,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;