2 # InspIRCd -- Internet Relay Chat Daemon
4 # Copyright (C) 2014-2017, 2019-2021 Sadie Powell <sadie@witchery.services>
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;
24 use warnings FATAL => qw(all);
26 use Class::Struct qw(struct);
27 use Exporter qw(import);
28 use File::Path qw(mkpath);
29 use File::Spec::Functions qw(rel2abs);
31 our @EXPORT = qw(command
58 sub console_format($) {
60 while ($message =~ /(<\|(\S+)\s(.*?)\|>)/) {
61 my ($match, $type, $text) = ($1, uc $2, $3);
62 if (-t STDOUT && exists $FORMAT_CODES{$type}) {
63 $message =~ s/\Q$match\E/$FORMAT_CODES{$type}$text$FORMAT_CODES{DEFAULT}/;
65 $message =~ s/\Q$match\E/$text/;
72 print STDERR console_format "<|RED Error:|> ";
74 say STDERR console_format $line;
80 print STDERR console_format "<|YELLOW Warning:|> ";
82 say STDERR console_format $line;
86 sub prompt_bool($$$) {
87 my ($interactive, $question, $default) = @_;
89 my $answer = prompt_string($interactive, $question, $default ? 'yes' : 'no');
90 return 1 if $answer =~ /^y(?:es)?$/i;
91 return 0 if $answer =~ /^no?$/i;
92 print_warning "\"$answer\" is not \"yes\" or \"no\". Please try again.\n";
96 sub prompt_dir($$$;$) {
97 my ($interactive, $question, $default, $create_now) = @_;
98 my ($answer, $create);
100 $answer = rel2abs(prompt_string($interactive, $question, $default));
101 $create = prompt_bool($interactive && !-d $answer, "$answer does not exist. Create it?", 'y');
102 if ($create && $create_now) {
103 unless (create_directory $answer, 0750) {
104 print_warning "unable to create $answer: $!\n";
112 sub prompt_string($$$) {
113 my ($interactive, $question, $default) = @_;
114 return $default unless $interactive;
115 say console_format $question;
116 print console_format "[<|GREEN $default|>] => ";
117 chomp(my $answer = <STDIN>);
119 return $answer ? $answer : $default;
123 my ($name, $description, $callback) = @_;
124 $commands{$name} = command->new;
125 $commands{$name}->callback($callback);
126 $commands{$name}->description($description);
129 sub command_alias($$) {
130 my ($source, $target) = @_;
131 command $source, undef, sub(@) {
132 execute_command $target, @_;
136 sub execute_command(@) {
137 my $command = defined $_[0] ? lc shift : 'help';
138 if ($command eq 'help') {
139 say console_format "<|GREEN Usage:|> $0 <<|UNDERLINE COMMAND|>> [<|UNDERLINE OPTIONS...|>]";
141 say console_format "<|GREEN Commands:|>";
142 for my $key (sort keys %commands) {
143 next unless defined $commands{$key}->description;
144 my $name = sprintf "%-15s", $key;
145 my $description = $commands{$key}->description;
146 say console_format " <|BOLD $name|> # $description";
149 } elsif (!$commands{$command}) {
150 print_error "no command called <|BOLD $command|> exists!",
151 "See <|BOLD $0 help|> for a list of commands.";
153 return $commands{$command}->callback->(@_);