2 # InspIRCd -- Internet Relay Chat Daemon
4 # Copyright (C) 2014-2017 Peter Powell <petpow@saberuk.com>
6 # This file is part of InspIRCd. InspIRCd is free software: you can
7 # redistribute it and/or modify it under the terms of the GNU General Public
8 # License as published by the Free Software Foundation, version 2.
10 # This program is distributed in the hope that it will be useful, but WITHOUT
11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
15 # You should have received a copy of the GNU General Public License
16 # along with this program. If not, see <http://www.gnu.org/licenses/>.
20 package make::console;
28 use warnings FATAL => qw(all);
30 use Class::Struct qw(struct);
31 use Exporter qw(import);
32 use File::Path qw(mkpath);
33 use File::Spec::Functions qw(rel2abs);
35 our @EXPORT = qw(command
62 sub __console_format($$) {
63 my ($name, $data) = @_;
64 return $data unless -t STDOUT;
65 return $FORMAT_CODES{uc $name} . $data . $FORMAT_CODES{DEFAULT};
68 sub print_format($;$) {
70 my $stream = shift // *STDOUT;
71 while ($message =~ /(<\|(\S+)\s(.*?)\|>)/) {
72 my $formatted = __console_format $2, $3;
73 $message =~ s/\Q$1\E/$formatted/;
75 print { $stream } $message;
79 print_format "<|RED Error:|> ", *STDERR;
81 print_format "$line\n", *STDERR;
87 print_format "<|YELLOW Warning:|> ", *STDERR;
89 print_format "$line\n", *STDERR;
93 sub prompt_bool($$$) {
94 my ($interactive, $question, $default) = @_;
96 my $answer = prompt_string($interactive, $question, $default ? 'yes' : 'no');
97 return 1 if $answer =~ /^y(?:es)?$/i;
98 return 0 if $answer =~ /^no?$/i;
99 print_warning "\"$answer\" is not \"yes\" or \"no\". Please try again.\n";
103 sub prompt_dir($$$;$) {
104 my ($interactive, $question, $default, $create_now) = @_;
105 my ($answer, $create);
107 $answer = rel2abs(prompt_string($interactive, $question, $default));
108 $create = prompt_bool($interactive && !-d $answer, "$answer does not exist. Create it?", 'y');
109 if ($create && $create_now) {
110 unless (create_directory $answer, 0750) {
111 print_warning "unable to create $answer: $!\n";
119 sub prompt_string($$$) {
120 my ($interactive, $question, $default) = @_;
121 return $default unless $interactive;
122 print_format "$question\n";
123 print_format "[<|GREEN $default|>] => ";
124 chomp(my $answer = <STDIN>);
126 return $answer ? $answer : $default;
130 my ($name, $description, $callback) = @_;
131 $commands{$name} = command->new;
132 $commands{$name}->callback($callback);
133 $commands{$name}->description($description);
136 sub command_alias($$) {
137 my ($source, $target) = @_;
138 command $source, undef, sub(@) {
139 execute_command $target, @_;
143 sub execute_command(@) {
144 my $command = defined $_[0] ? lc shift : 'help';
145 if ($command eq 'help') {
146 print_format "<|GREEN Usage:|> $0 <<|UNDERLINE COMMAND|>> [<|UNDERLINE OPTIONS...|>]\n\n";
147 print_format "<|GREEN Commands:|>\n";
148 for my $key (sort keys %commands) {
149 next unless defined $commands{$key}->description;
150 my $name = sprintf "%-15s", $key;
151 my $description = $commands{$key}->description;
152 print_format " <|BOLD $name|> # $description\n";
155 } elsif (!$commands{$command}) {
156 print_error "no command called <|BOLD $command|> exists!",
157 "See <|BOLD $0 help|> for a list of commands.";
159 return $commands{$command}->callback->(@_);